home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / timerh.com / TIMERH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1990-01-15  |  6.6 KB  |  170 lines
  1. { =========================================================================== }
  2. { Timer55.pas - High resolution timer                       ver 5.5, 01-15-90 }
  3. {                                                                             }
  4. { A precise 24 hour timer with resolution of 1 micro-second to measure        }
  5. { elapsed time in seconds.                                                    }
  6. {                                                                             }
  7. {   Public Domain                                                             }
  8. {   by Jim LeMay                                                              }
  9. {   Eagle Performance Software                                                }
  10. {   P.O. Box 292786                                                           }
  11. {   Lewisville, TX  75029-2786                                                }
  12. {   (214)-539-7855                                                            }
  13. {                                                                             }
  14. { =========================================================================== }
  15.  
  16. {$A+,D-,F-,L-,R-,S-}
  17.  
  18. UNIT TimerH;
  19.  
  20.  
  21. INTERFACE
  22.  
  23. type
  24.   StartStop = (Start, Stop, Sync);
  25.  
  26. var
  27.   t0,                 { Timer overhead     (seconds) }
  28.   t1,                 { Time at last Start (seconds) }
  29.   t2,                 { Time at last Stop  (seconds) }
  30.   ElapsedTime: real;  { Time between last start and last stop. (seconds) }
  31.  
  32. procedure Timer (SS: StartStop);
  33.  
  34.  
  35. IMPLEMENTATION
  36.  
  37. type
  38.   TicksArray = array [1..5] of byte;
  39.  
  40. var
  41.   PrevExitProc:    pointer;
  42.   T1array,T2array: TicksArray;
  43.  
  44. const
  45.   TicksPerDay = 103090749440.0;        { 2^16 * 1573040 DOS timer ticks/day. }
  46.   TicksPerSec = TicksPerDay/86400.0;
  47.  
  48. procedure SetTimerMode;
  49. begin
  50.   Inline
  51.     ($B0/$34  { mov   al,$34  ; For counter 0, mode 2 }
  52.     /$E6/$43  { out   $43,al  ; Set timer for input   }
  53.     /$EB/$00  { jmp   short $0; Null jump             }
  54.     /$31/$C0  { xor   ax,ax   ; Set ax=0 (Max count)  }
  55.     /$E6/$40  { out   $40,al  ; LSB first             }
  56.     /$EB/$00  { jmp   short $0; Null jump             }
  57.     /$E6/$40);{ out   $40,al  ; MSB second            }
  58. end;
  59.  
  60. procedure GetTicks (VAR Ticks: TicksArray);
  61. begin
  62. Inline(
  63.   $31/$D2/             { xor   dx,dx          ; Set DX=0 }
  64.   $8E/$C2/             { mov   es,dx          ; Segment for DOS timer }
  65.   $88/$D0/             { mov   al,dl          ; 0 to latch counter 0 }
  66.                        {                      ; }
  67.   $FA/                 { cli                  ; Prevent interrupts }
  68.   $26/$8A/$1E/$6C/$04/ { es:   mov bl,[$046C] ; Low byte of system timer }
  69.   $26/$8B/$36/$6D/$04/ { es:   mov si,[$046D] ; Mid word of system timer }
  70.   $FB/                 { sti                  ; Enable interrupts AFTER OUT }
  71.                        { ; Interrupts not enabled yet }
  72.   $E6/$43/             { out   $43,al         ; Latch timer }
  73.                        {                      ;  Now, interrupts enabled }
  74.                        { ; Let system clock be updated now }
  75.   $26/$8A/$3E/$6C/$04/ { es:   mov bh,[$046C] ; Again copy of the Low byte }
  76.   $B2/$40/             { mov   dl,$40         ; Data port for timer }
  77.   $EC/                 { in    al,dx          ; Timer chip LSB }
  78.   $EB/$00/             { jmp   short $0       ; Null jump }
  79.   $88/$C1/             { mov   cl,al          ; Save in CL }
  80.   $EC/                 { in    al,dx          ; Timer chip MSB }
  81.   $88/$C5/             { mov   ch,al          ; Move in CH }
  82.   $F7/$D1/             { not   cx             ; Convert count-down to up }
  83.                        {                      ; }
  84.   $80/$FD/$0A/         { cmp   ch,10          ; Since system tick <10ms? }
  85.   $D0/$D6/             { rcl   dh,1           ; Save copy of CF }
  86.   $28/$DF/             { sub   bh,bl          ; BH=1 if before<>after }
  87.   $20/$FE/             { and   dh,bh          ; DH=1 if pending tick INT }
  88.   $00/$F3/             { add   bl,dh          ; Inc if INT was pending }
  89.   $83/$D6/$00/         { adc   si,$0000       ; Just propogate carry bit }
  90.                        {                      ; }
  91.   $C4/$7E/<TICKS/      { les   di,[bp+<Ticks] ; Load address of ticks }
  92.   $FC/                 { cld                  ; Set direction forward }
  93.   $89/$C8/             { mov   ax,cx          ; Move  chip timer word }
  94.   $AB/                 { stosw                ; Store chip timer word }
  95.   $88/$D8/             { mov   al,bl          ; Move  system low byte }
  96.   $AA/                 { stosb                ; Store system low byte }
  97.   $89/$F0/             { mov   ax,si          ; Move  system mid word }
  98.   $AB);                { stosw                ; Store system mid word }
  99. end;
  100.  
  101. function ArrayToReal (Ticks: TicksArray): real;
  102. var
  103.   T: record
  104.       B: byte;
  105.       L: longint;
  106.      end absolute Ticks;
  107. begin
  108.   ArrayToReal := (T.L)*256.0 + T.B;
  109. end;
  110.  
  111. procedure Timer;
  112. begin
  113.   case SS of
  114.     Start: begin
  115.              ElapsedTime := 0;
  116.              GetTicks (T1array)
  117.            end;
  118.     Stop:  begin
  119.              GetTicks (T2array);
  120.              t1 := ArrayToReal (T1array);        { Convert AFTER the event! }
  121.              t2 := ArrayToReal (T2array);
  122.              if t2<t1 then
  123.                t2 := t2+TicksPerDay;
  124.              ElapsedTime := (t2-t1-t0)/TicksPerSec   { units of seconds }
  125.            end;
  126.     Sync:  SetTimerMode;
  127.   end;
  128. end;
  129.  
  130. procedure TimerInit;
  131. var
  132.   least: real;
  133.   b:     byte;
  134. begin
  135.   t0    := 0.0;                        { Initial value to prevent overflow }
  136.   least := 1000000.0;                  { Initial value that's too high }
  137.   for b:=1 to 10 do
  138.     begin                              { Check timer overhead by timing }
  139.       Timer (Start);                   { itself.  Do it 10 times to get the }
  140.       Timer (Stop);                    { least value.  }
  141.       t0 := ArrayToReal(T2array) - ArrayToReal(T1array);
  142.       if t0<least then
  143.         least:=t0;
  144.     end;
  145.   t0 := least;                         { Minimum overhead for timer }
  146. end;
  147.  
  148. {$F+}
  149. procedure ExitTimerH;
  150. begin
  151.   ExitProc := PrevExitProc;
  152.   { -- Restore default timer mode -- }
  153.   Inline
  154.     ($B0/$36  { mov   al,$36  ; For counter 0, mode 3 }
  155.     /$E6/$43  { out   $43,al  ; Set timer for input   }
  156.     /$EB/$00  { jmp   short $0; Null jump             }
  157.     /$31/$C0  { xor   ax,ax   ; Set ax=0 (Max count)  }
  158.     /$E6/$40  { out   $40,al  ; LSB first             }
  159.     /$EB/$00  { jmp   short $0; Null jump             }
  160.     /$E6/$40);{ out   $40,al  ; MSB second            }
  161. end;
  162. {$F-}
  163.  
  164. BEGIN
  165.   PrevExitProc := ExitProc;
  166.   ExitProc     := @ExitTimerH;
  167.   SetTimerMode;
  168.   TimerInit;
  169. END.
  170.